---
title: "COVID19 Dashboard"
output:
flexdashboard::flex_dashboard:
orientation: rows
vertical_layout: fill
social: [ "twitter", "facebook", "menu"]
source_code: embed
---
```{r setup, include=FALSE}
library(flexdashboard)
# library(knitr)
#integrar visualización
library(patchwork)
library(DT)
library(rpivotTable)
library(ggplot2)
library(plotly)
library(dplyr)
library(openintro)
library(highcharter)
library(ggvis)
library(tidyverse)
# library(tibbletime)
library(reactable)
library(htmltools)
library(fpp3)
library(feasts)
library(fable)
library(tsibble)
library(lubridate)
library(kableExtra)
library(formattable)
#importación y lectura
library(readxl)
library(tidyr)
library(vroom)
#Mapas
library(leaflet)
library(ggmap) # -> para obtener lon y lat de los municipios
library(raster)
library(spData)
library(tmap)
library(RJSONIO)
library(tmaptools)
library(Hmisc)
library(mxmaps) #se instala con un repo de gitgub con el
#siguiente comando
#if (!require("devtools")) {
# install.packages("devtools")
# }
# devtools::install_github("diegovalle/mxmaps")
library(sf)
library(scales) # needed for comma
library(rgeos)
library(maptools)
library(leaflet)
library(geojsonio)
library(jsonlite)
```
```{r}
data <- read_csv("VehicleFailure.csv")
delitos <- read_csv("../Delitos/delitos2015-2021.csv",
locale(encoding = "latin1"),
col_names = TRUE,
col_types = NULL
)
#######Quedarse solo con las columnas y filas necesarias#######
delitos_a_comparar <- c("Feminicidio", "Abuso sexual",
"Acoso sexual", "Hostigamiento sexual",
"Otros delitos que atentan contra la libertad y la seguridad sexual",
"Violación simple", "Violación equiparada", "Trata de personas",
"Tráfico de menores", "Secuestro", "Violencia familiar")
delitos_tidy <- delitos %>%
filter( Tipo_de_delito %in% delitos_a_comparar |
Subtipo_de_delito == "Homicidio doloso" |
Subtipo_de_delito == "Lesiones dolosas" ) %>%
pivot_longer(
cols = Enero:Diciembre ,
names_to = "Meses",
values_to = "Cuenta"
) %>%
group_by(Ano, Meses, Tipo_de_delito, Subtipo_de_delito) %>%
summarise(Cuenta = sum(Cuenta), .groups = "drop")
delitos_tidy <- delitos_tidy %>%
mutate(
Meses = str_trunc(Meses, width = 3, ellipsis = ""),
Meses = case_when(
Meses == "Ene" ~ "Jan",
Meses == "Abr" ~ "Apr",
Meses == "Ago" ~ "Aug",
Meses == "Dic" ~ "Dec",
TRUE ~ Meses
)
) %>%
unite(col = "Fecha", c(Ano,Meses), sep = " ") %>%
mutate(Fecha = yearmonth(Fecha))
delitos_tidy_tsbl <- delitos_tidy %>%
as_tsibble(
index = Fecha,
key = c(Tipo_de_delito, Subtipo_de_delito)
)
mycolors <- c("blue", "#FFC125", "darkgreen", "darkorange")
```
Delitos en época de COVID19
=====================================
Row
-------------------------------
### Tabla de incidencia
```{r}
#Tabla de incidencia
Incidencia_2019 <-delitos_tidy_tsbl %>%
tsibble::group_by_key() %>%
tsibble::index_by(Año = year(Fecha)) %>%
dplyr::summarise(Cuenta = sum(Cuenta)) %>%
dplyr::filter(Año %in% 2019) %>%
dplyr::as_tibble(Incidencia_2019) %>%
dplyr::transmute( Delito = Tipo_de_delito,
Incidencia_2019 = Cuenta)
Incidencia_2020 <- delitos_tidy_tsbl %>%
group_by_key() %>%
index_by(Año = year(Fecha)) %>%
dplyr::summarise(Cuenta = sum(Cuenta)) %>%
dplyr::filter(Año %in% 2020) %>%
dplyr::as_tibble(Incidencia_2020) %>%
dplyr::mutate(Delito = Tipo_de_delito,
Incidencia_2020 = Cuenta) %>%
dplyr::select(Delito, Incidencia_2020)
Incidencia <- Incidencia_2020 %>%
add_column(Incidencia_2019$Incidencia_2019) %>%
dplyr::mutate(
Porcentaje_de_cambio = round((
(Incidencia_2020 - Incidencia_2019$Incidencia_2019)/Incidencia_2020), digits = 5),
Incidencia_2019 = Incidencia_2019$Incidencia_2019) %>%
dplyr::select(Delito, Incidencia_2019, Incidencia_2020, Porcentaje_de_cambio)%>%
arrange(desc(Porcentaje_de_cambio))
Tabla <- Incidencia %>%
mutate(Porcentaje_de_cambio = percent(Porcentaje_de_cambio, 2)) %>%
kbl(fortmat = "htlm", col.names = c("Delitos",
"Incidencia en 2019",
"Incidencia en 2020",
"Porcentaje de cambio")) %>%
kable_styling(bootstrap_options = "striped",
full_width = F,
position = "left",
font_size = 14) %>%
column_spec(4,color = ifelse( Incidencia$Porcentaje_de_cambio > 0, "red", "green"))
Tabla
```
### Delitos sexuales y de género
```{r}
sexuales_y_genero = c("Abuso sexual",
"Acoso sexual",
"Feminicidio",
"Violación simple",
"Violación equiparada",
"Hostigamiento sexual",
"Otros delitos que atentan contra la libertad y la seguridad sexual")
p2 <- delitos_tidy_tsbl %>%
filter (Tipo_de_delito %in% sexuales_y_genero) %>%
ggplot() +
geom_line(mapping = aes(x = Fecha, y = Cuenta, color = Tipo_de_delito))
p2
```
### Delitos contra la libertad
```{r}
p3 <- delitos_tidy_tsbl %>%
filter (Tipo_de_delito %in% c("Trata de personas", "Tráfico de menores", "Secuestro") ) %>%
ggplot() +
geom_line(mapping = aes(x = Fecha, y = Cuenta, color = Tipo_de_delito))
p3
```
Row
------------------------------------
### Delitos dolosos
```{r}
p4 <- delitos_tidy_tsbl %>%
filter(Subtipo_de_delito %in% c("Lesiones dolosas", "Homicidio doloso")) %>%
ggplot() +
geom_line(mapping = aes(x = Fecha, y = Cuenta, color = Tipo_de_delito))
p4
```
### Delitos violencia familiar
```{r}
p5 <- delitos_tidy_tsbl %>%
filter (Tipo_de_delito == "Violencia familiar") %>%
ggplot() +
geom_line(mapping = aes(x = Fecha, y = Cuenta, color = Tipo_de_delito))
p5
```
Mapa nacional 1 y pruebas realizadas
========================================
Row
------------------------------------
### Mapa nacional de resultados positivos
```{r}
# car <- data %>%
# group_by(State) %>%
# summarize(total = n())
# car$State <- abbr2state(car$State)
#
# highchart() %>%
# hc_title(text = "Car Failures in US") %>%
# hc_subtitle(text = "Source: Vehiclefailure.csv") %>%
# hc_add_series_map(usgeojson, car,
# name = "State",
# value = "total",
# joinBy = c("woename", "State")) %>%
# hc_mapNavigation(enabled = T)
# lubridate::today()-1
# fecha <- "210415"
options(timeout = 700)
temp <- tempfile()
download.file("http://datosabiertos.salud.gob.mx/gobmx/salud/datos_abiertos/datos_abiertos_covid19.zip", temp)
Datosmex2502 <- vroom::vroom(unz(temp, unzip(temp, list = TRUE) %>% pull(Name)))
unlink(temp)
```
```{r}
Entidades <- read_xlsx("../Datos nacionales abiertos/201128 Catalogos.xlsx",sheet="Catálogo de ENTIDADES")
# Clasificación de datos -------------------------------------------------
#datos necesarios para la prueba
datosimportates <- dplyr::select(Datosmex2502,`FECHA_INGRESO`,`ENTIDAD_RES`,
`TOMA_MUESTRA_LAB`,`RESULTADO_LAB`, `TOMA_MUESTRA_ANTIGENO`,
`RESULTADO_ANTIGENO`, `CLASIFICACION_FINAL`)%>%
left_join(Entidades, by=c("ENTIDAD_RES"="CLAVE_ENTIDAD"))
#datos confirmados sin realización de pruebas
confirmados <- datosimportates %>%
filter(`CLASIFICACION_FINAL`%in% c(1,2,3)) %>%
dplyr::select(`FECHA_INGRESO`, `ENTIDAD_RES`, `ENTIDAD_FEDERATIVA`, `ABREVIATURA`) %>%
mutate(
year = lubridate::year(FECHA_INGRESO),
month = lubridate::month(FECHA_INGRESO),
day = lubridate::day(FECHA_INGRESO)
) %>%
drop_na(`ENTIDAD_FEDERATIVA`, `FECHA_INGRESO`)
# Agrupación de datos ----------------------------------------------------
#Numero de positivos por estado
positivosestado <- confirmados %>%
group_by(`ENTIDAD_RES`) %>%
summarise(
count=n(),
)
#Selección de nombre estados, por orden de codigo
nombreEstado <- Entidades %>%
dplyr::select(`ENTIDAD_FEDERATIVA`) %>%
slice( 1:32)
mapaPositivos <- positivosestado %>%
add_column(nombreEstado)
# Mapa -------------------------------------------------------------------
# data(mapaPositivos)
# mapaPositivos$rand <- mapaPositivos$count
# mapaPositivos$region <- mapaPositivos$ENTIDAD_RES
# mxstate_choropleth(mapaPositivos,
# title = "Casos confirmados de COVID por estado.",
# legend = "Número de casos.",
# )
# Convert the topoJSON to spatial object
tmpdir <- tempdir()
# have to use RJSONIO or else the topojson isn't valid
write(RJSONIO::toJSON(mxstate.topoJSON), file.path(tmpdir, "sta.topojson"))
mxstate <- topojson_read(file.path(tmpdir, "sta.topojson"))
#ordenamos los datos del topoJSON en orden numérico
mxstate <- mxstate[order(mxstate$id),]
mxstate <- as_Spatial(mxstate)
mxstate$rand <- mapaPositivos$count
bins <- c(5000,20000 , 30000, 35000, 50000, 60000, 115000,300000, Inf)
pal <- colorBin("YlOrRd", domain = mxstate$rand, bins=bins)
etiqueta <- paste(
"Estado: ", mapaPositivos$ENTIDAD_FEDERATIVA, "
",
"Número de casos: ", mapaPositivos$count
) %>%
lapply(htmltools::HTML)
leaflet(mxstate) %>%
addPolygons(
fillColor = ~pal(mxstate$rand),
fillOpacity = 1,
stroke = TRUE,
color = "White",
weight = 1.5,
dashArray = "3",
highlight = highlightOptions(
weight = 5,
color = "#666",
dashArray = "",
fillOpacity = 0.7,
bringToFront = TRUE),
label = etiqueta,
)%>%
addLegend(pal = pal, values = ~mapaPositivos$rand, opacity = 0.7, title = "Casos
positivos
contagios",
position = "bottomright")%>%
addTiles() %>%
addMarkers(50, 50) %>%
addControl("Positivos totales COVID19 México", position = "bottomleft") %>%
addProviderTiles("CartoDB.Positron")
```
Row
------------------------------------
### Pruebas realizadas por estado
```{r}
# # Importación de datos ----------------------------------------------------
#
#
# # Datosmex2502 <- read_csv("210225COVID19MEXICO.csv")
# # Descarga de datos desde la página web
# fecha <- "210412"
# options(timeout = 600)
# temp <- tempfile()
# download.file("http://datosabiertos.salud.gob.mx/gobmx/salud/datos_abiertos/datos_abiertos_covid19.zip", temp)
#
#
# Datosmex2502 <- vroom::vroom(unz(temp, paste0(fecha,"COVID19MEXICO.csv")))
# unlink(temp)
#
#
# Entidades <- read_xlsx("Datos nacionales abiertos/201128 Catalogos.xlsx",sheet="Catálogo de ENTIDADES")
# # Clásificación ----------------------------------------------------------
#
# #datos necesarios para la prueba
# datosimportates <- dplyr::select(Datosmex2502,`FECHA_INGRESO`,`ENTIDAD_RES`,
# `TOMA_MUESTRA_LAB`,`RESULTADO_LAB`, `TOMA_MUESTRA_ANTIGENO`,
# `RESULTADO_ANTIGENO`, `CLASIFICACION_FINAL`)%>%
# left_join(Entidades, by=c("ENTIDAD_RES"="CLAVE_ENTIDAD"))
#datos de las pruebas realizadas ese día en todo el país
pruebasfiltro <- datosimportates %>%
dplyr::filter(`TOMA_MUESTRA_LAB`== 1 | `TOMA_MUESTRA_ANTIGENO`==1 ) %>%
dplyr::select(`FECHA_INGRESO`, `ENTIDAD_RES`,`ENTIDAD_FEDERATIVA`,`ABREVIATURA`) %>%
mutate(
year = lubridate::year(FECHA_INGRESO),
month = lubridate::month(FECHA_INGRESO),
day = lubridate::day(FECHA_INGRESO)
) %>%
drop_na(`ENTIDAD_FEDERATIVA`, `FECHA_INGRESO`)
# Agrupación de datos ----------------------------------------------------
#Numero de pruebas por estado totales hasta la fecha de datos
pruebasXEstado <- pruebasfiltro %>%
group_by(`ENTIDAD_FEDERATIVA`) %>%
mutate(`Numero de pruebas`=n()) %>%
distinct(`ENTIDAD_FEDERATIVA`, .keep_all = TRUE) %>%
arrange(`ENTIDAD_FEDERATIVA`) %>%
drop_na(`ENTIDAD_FEDERATIVA`)
pruebasXEstado <- pruebasXEstado %>%
dplyr::select(
`ENTIDAD_FEDERATIVA`,
`Numero de pruebas`
)
pruebasfiltro$FECHA_INGRESO <- format(pruebasfiltro$FECHA_INGRESO, "%Y-%m")
#Numero de pruebas por estado según el día
pruebasxEstadoxDia <- pruebasfiltro %>%
group_by(`ENTIDAD_RES`, `FECHA_INGRESO`) %>%
mutate(count=n()) %>%
distinct(`ENTIDAD_RES`, .keep_all = TRUE) %>%
arrange(`ENTIDAD_RES`) %>%
drop_na(`ENTIDAD_FEDERATIVA`)
# Gráfica ----------------------------------------------------------------
ggplot(data = pruebasfiltro) +
geom_bar(mapping = aes(y = FECHA_INGRESO, fill = ABREVIATURA), position = "dodge")
```
### Pruebas realizadas por estado
```{r}
# Tabla ------------------------------------------------------------------
#Tabla que muestra el número de pruebas que se hacen por día en los estados
formattable(pruebasXEstado, #llamo datos
align =c("l","c"), #Para alinear los datos de la tabla cada "" es una columna
list(`ENTIDAD_FEDERATIVA` = formatter( #datos específicos
"span", style = ~ style(color = "grey",font.weight = "bold")),
`Numero de pruebas` = color_bar("Red") # me crea una barra roja con proporción a los datos
)
)
```
Mapa porcentaje de positividad
========================================
Row
------------------------------------
### Porcentaje total
```{r}
# Importación de datos ----------------------------------------------------
#Datosmex2502 <- read_csv("210225COVID19MEXICO.csv")
# Descarga de datos desde la página web
# fecha <- "210414"
# options(timeout = 700)
# temp <- tempfile()
# download.file("http://datosabiertos.salud.gob.mx/gobmx/salud/datos_abiertos/datos_abiertos_covid19.zip", temp)
#
#
# Datosmex2502 <- vroom::vroom(unz(temp, unzip(temp, list = TRUE) %>% pull(Name)))
# unlink(temp)
#
#
# Entidades <- read_xlsx("Datos nacionales abiertos/201128 Catalogos.xlsx",sheet="Catálogo de ENTIDADES")
#
# # Clasificación de datos -------------------------------------------------
#
# #datos necesarios para la prueba
# datosimportates <- dplyr::select(Datosmex2502,`FECHA_INGRESO`,`ENTIDAD_RES`,
# `TOMA_MUESTRA_LAB`,`RESULTADO_LAB`, `TOMA_MUESTRA_ANTIGENO`,
# `RESULTADO_ANTIGENO`, `CLASIFICACION_FINAL`)%>%
# left_join(Entidades, by=c("ENTIDAD_RES"="CLAVE_ENTIDAD"))
#
#
#
# #datos confirmados sin realización de pruebas
# confirmados <- datosimportates %>%
# filter(`CLASIFICACION_FINAL`%in% c(1,2,3)) %>%
# dplyr::select(`FECHA_INGRESO`, `ENTIDAD_RES`, `ENTIDAD_FEDERATIVA`, `ABREVIATURA`) %>%
# mutate(
# year = lubridate::year(FECHA_INGRESO),
# month = lubridate::month(FECHA_INGRESO),
# day = lubridate::day(FECHA_INGRESO)
# ) %>%
# drop_na(`ENTIDAD_FEDERATIVA`, `FECHA_INGRESO`)
#datos de las pruebas realizadas ese día en todo el país
pruebasfiltro <- datosimportates %>%
dplyr::filter(`TOMA_MUESTRA_LAB`== 1 | `TOMA_MUESTRA_ANTIGENO`==1 ) %>%
dplyr::select(`FECHA_INGRESO`, `ENTIDAD_RES`,`ENTIDAD_FEDERATIVA`,`ABREVIATURA`) %>%
mutate(
year = lubridate::year(FECHA_INGRESO),
month = lubridate::month(FECHA_INGRESO),
day = lubridate::day(FECHA_INGRESO)
) %>%
drop_na(`ENTIDAD_FEDERATIVA`, `FECHA_INGRESO`)
#Separación de datos por fechas para mapas
pruebas2020 <- dplyr::filter(pruebasfiltro, year==2020)
pruebEstado2020 <- pruebas2020 %>%
group_by(`ENTIDAD_RES`) %>%
summarise(
count=n()
)
pruebas2021 <- dplyr::filter(pruebasfiltro, year==2021)
pruebEstado2021 <- pruebas2021 %>%
group_by(`ENTIDAD_RES`) %>%
summarise(
count=n()
)
#confirmados por año para mapas
confirm2020 <- confirmados %>%
dplyr::filter( year==2020) %>%
drop_na(`ENTIDAD_FEDERATIVA`)
confirmEstado2020 <- confirm2020 %>%
group_by(`ENTIDAD_RES`) %>%
summarise(
count=n()
)
confirm2021 <- confirmados %>%
dplyr::filter( year==2021) %>%
drop_na(`ENTIDAD_FEDERATIVA`)
confirmEstado2021 <- confirm2021 %>%
group_by(`ENTIDAD_RES`) %>%
summarise(
count=n()
)
#Numero de pruebas por estado totales hasta la fecha de datos
pruebasXEstado <- pruebasfiltro %>%
group_by(`ENTIDAD_RES`) %>%
mutate(PRUEBAS=n()) %>%
distinct(`ENTIDAD_RES`, .keep_all = TRUE) %>%
arrange(`ENTIDAD_RES`) %>%
drop_na()
# #Numero de pruebas por estado según el día
# pruebasxEstadoxDia <- pruebasfiltro %>%
# group_by(`ENTIDAD_RES`,`FECHA_INGRESO`) %>%
# mutate(count=n()) %>%
# distinct(`ENTIDAD_RES`, .keep_all = TRUE) %>%
# arrange(`ENTIDAD_RES`) %>%
# drop_na()
#
#
# prubeasXEstadotsbl <- pruebasxEstadoxDia %>%
# as_tsibble( key = `ENTIDAD_RES`,
# index = `FECHA_INGRESO`
# )
# group_split(pruebasxEstadoxDia)
# group_keys(pruebasxEstadoxDia)
#Positivos por estado totales hasta la fecha de datos
positivoxEstado <- confirmados %>%
group_by(`ENTIDAD_RES`) %>%
mutate(CONFIRMADOS=n()) %>%
distinct(`ENTIDAD_RES`, .keep_all = TRUE) %>%
arrange(`ENTIDAD_RES`) %>%
dplyr::select(ENTIDAD_RES, ENTIDAD_FEDERATIVA, CONFIRMADOS )
# #Positivos por estado según el día
# positivoxEstadoxDia <- confirmados %>%
# group_by(`ENTIDAD_RES`, `FECHA_INGRESO`) %>%
# mutate(count=n()) %>%
# distinct(`ENTIDAD_RES`, .keep_all = TRUE) %>%
# arrange(`ENTIDAD_RES`) %>%
# drop_na()
#
# positivoXDiatsbl <- positivoxEstadoxDia %>%
# as_tsibble( key = ENTIDAD_RES,
# index = FECHA_INGRESO
#
# )
#Selección de nombre estados, por orden de codigo
nombreEstado <- Entidades %>%
dplyr::select(`ENTIDAD_FEDERATIVA`) %>%
slice( 1:32)
# Agrupación de datos totales -----------------------------------------------------
# #suma total de las pruebas realizadas
totalpruebas <- pruebasXEstado$PRUEBAS %>%
sum(na.rm = TRUE)
#suma total de las pruebas que salieron positivas
totalpositivas <- positivoxEstado$CONFIRMADOS %>%
sum(na.rm = TRUE)
#Porcentaje por estado de las pruebas positivas a el total de pruebas realizadas en los estados
positividadPais <- (totalpositivas/totalpruebas)*100
#positividadPais
positividad <- ((positivoxEstado$CONFIRMADOS/pruebasXEstado$PRUEBAS)*100)
#positividad
#porcentaje total de las pruebas positivas de acuerdo a que estado.
porcenestado <- (positivoxEstado$CONFIRMADOS/totalpositivas)*100
porcenestado <- as.numeric(porcenestado)
#porcenestado
#Porcentaje total de pruebas positvas
porcen <- sum(positividad, na.rm = TRUE)
#verificación de suma de porcentaje de pruebas positivas (porcenestado)
sumporcentaje <- sum(porcenestado, na.rm = TRUE)
# creamos tibble con datos de codigo de entidad y casos positivos
nueva <- positivoxEstado %>%
#agregamos porcentajes de acuerdo al total de pruebas positivas
add_column(porcenestado)%>%
#agregamos porcentajes del total de pruebas
add_column(positividad) %>%
add_column(pruebasXEstado$PRUEBAS)
# #Agregamos el nombre de los estados por orden de codigo
# add_column(nombreEstado)
# Agrupación de datos 2020 ------------------------------------------------
# #suma total de las pruebas realizadas
# totalpruebas2020 <- pruebEstado2020$count %>%
# sum(na.rm = TRUE)
#suma total de las pruebas que salieron positivas
totalpositivas2020 <- confirmEstado2020$count %>%
sum(na.rm = TRUE)
#Porcentaje por estado de las pruebas positivas a el total de pruebas realizadas en los estados
positividad2020 <- (confirmEstado2020$count/pruebEstado2020$count)*100
#positividad2020
#porcentaje total de las pruebas positivas de acuerdo a que estado.
porcenestado2020 <- (confirmEstado2020$count/totalpositivas2020)*100
porcenestado2020 <- as.numeric(porcenestado)
#porcenestado2020
#Porcentaje total de pruebas positvas
porcen2020 <- sum(positividad2020, na.rm = TRUE)
#verificación de suma de porcentaje de pruebas positivas (porcenestado)
sumporcentaje2020 <- sum(porcenestado2020, na.rm = TRUE)
# creamos tibble con datos de codigo de entidad y casos positivos
nueva2020 <- confirmEstado2020 %>%
#agregamos porcentajes de acuerdo al total de pruebas positivas
add_column(porcenestado2020)%>%
#agregamos porcentajes del total de pruebas
add_column(positividad2020) %>%
#Agregamos el nombre de los estados por orden de codigo
add_column(nombreEstado)
# Agrupación de datos 2021 ------------------------------------------------
# #suma total de las pruebas realizadas
# totalpruebas2021 <- pruebEstado2021$count %>%
# sum(na.rm = TRUE)
#suma total de las pruebas que salieron positivas
totalpositivas2021 <- confirmEstado2021$count %>%
sum(na.rm = TRUE)
#Porcentaje por estado de las pruebas positivas a el total de pruebas realizadas en los estados
positividad2021 <- (confirmEstado2021$count/pruebEstado2021$count)*100
#positividad2021
#porcentaje total de las pruebas positivas de acuerdo a que estado.
porcenestado2021 <- (confirmEstado2021$count/totalpositivas2021)*100
porcenestado2021 <- as.numeric(porcenestado2021)
#porcenestado2021
#Porcentaje total de pruebas positvas
porcen2021 <- sum(positividad2021, na.rm = TRUE)
#verificación de suma de porcentaje de pruebas positivas (porcenestado)
sumporcentaje2021 <- sum(porcenestado2021, na.rm = TRUE)
# creamos tibble con datos de codigo de entidad y casos positivos
nueva2021 <- confirmEstado2021 %>%
#agregamos porcentajes de acuerdo al total de pruebas positivas
add_column(porcenestado2021)%>%
#agregamos porcentajes del total de pruebas
add_column(positividad2021) %>%
#Agregamos el nombre de los estados por orden de codigo
add_column(nombreEstado)
# Mapa de positividad total --------------------------------------------------------------------
# de acuerdo al número de pruebas realizadas se calcula el porcentaje de las
#pruebas que fueron seleccionadas como positivas. (por estado)
#data(nueva)
nueva$value <- nueva$positividad
nueva$region <- nueva$ENTIDAD_RES
# mxstate_choropleth(nueva,
# num_colors = 1,
# title = "Porcentaje de casos positivos",
# legend = "%",
# )
#Mapa interactivo
bins = c(15, 18, 21, 24, 27, 30, 33, 36, 39, 42, 45, 48, 51, 54, 57, 60, 63, 66, 69, 72)
pal <- colorBin("viridis", domain = nueva$value, bins=bins)
mxstate_leaflet(nueva,
pal,
~ pal(value),
~ sprintf("Estado: %s
Porcentaje de positividad : %s",
ENTIDAD_FEDERATIVA , comma(value) )) %>%
addLegend(position = "bottomright",
pal = pal,
values = nueva$value,
title = "Percentaje
Positividad",
labFormat = labelFormat(suffix = "%",
)) %>%
addTiles() %>%
addMarkers(50, 50) %>%
addControl("Mapa positividad de las pruebas totales", position = "bottomleft") %>%
addProviderTiles("CartoDB.Positron")
```
Row
------------------------------------
### Porcentaje 2020
```{r}
# Mapa 2020 ---------------------------------------------------------------
# de acuerdo al número de pruebas realizadas se calcula el porcentaje de las
#pruebas que fueron seleccionadas como positivas. (por estado del año 2020)
data(nueva2020)
nueva2020$value <- nueva2020$positividad2020
nueva2020$region <- nueva2020$ENTIDAD_RES
# mxstate_choropleth(nueva,
# num_colors = 1,
# title = "Porcentaje de casos positivos",
# legend = "%",
# )
#Mapa interactivo
bins=c(15, 18, 21, 24, 27, 30, 33, 36, 39, 42, 45, 48, 51, 54, 57, 60, 63, 66, 69, 72)
pal <- colorBin("viridis", domain = nueva2020$value, bins=bins)
mxstate_leaflet(nueva2020,
pal,
~ pal(value),
~ sprintf("Estado: %s
Porcentaje de positividad : %s",
ENTIDAD_FEDERATIVA , comma(value) )) %>%
addLegend(position = "bottomright",
pal = pal,
values = nueva2020$value,
title = "Percentaje
Positividad",
labFormat = labelFormat(suffix = "%",
)) %>%
addTiles() %>%
addMarkers(50, 50) %>%
addControl("Mapa positividad de las pruebas en 2020", position = "bottomleft") %>%
addProviderTiles("CartoDB.Positron")
```
### Porcentaje 2021
```{r}
# Mapa 2021 ---------------------------------------------------------------
# de acuerdo al número de pruebas realizadas se calcula el porcentaje de las
#pruebas que fueron seleccionadas como positivas. (por estado del año 2021)
data(nueva2021)
nueva2021$value <- nueva2021$positividad2021
nueva2021$region <- nueva2021$ENTIDAD_RES
# mxstate_choropleth(nueva2021,
# num_colors = 1,
# title = "Porcentaje de casos positivos",
# legend = "%",
# )
#Mapa interactivo
bins = c(15, 18, 21, 24, 27, 30, 33, 36, 39, 42, 45, 48, 51, 54, 57, 60, 63, 66, 69, 72)
pal <- colorBin("viridis", domain = nueva2021$value, bins=bins)
mxstate_leaflet(nueva2021,
pal,
~ pal(value),
~ sprintf("Estado: %s
Porcentaje de positividad : %s",
ENTIDAD_FEDERATIVA , comma(value) )) %>%
addLegend(position = "bottomright",
pal = pal,
values = nueva2021$value,
title = "Percentaje
Positividad",
labFormat = labelFormat(suffix = "%",
)) %>%
addTiles() %>%
addMarkers(50, 50) %>%
addControl("Mapa positividad de pruebas en 2021", position = "bottomleft") %>%
addProviderTiles("CartoDB.Positron")
```
```{r}
# Carga de datos ----------------------------------------------------------
#Se importan los datos como un tibble
Vacunastotales <- readr::read_csv("https://raw.githubusercontent.com/owid/covid-19-data/master/public/data/vaccinations/vaccinations.csv")
# Wrangle data ------------------------------------------------------------
#Se quiere trabajar con series de tiempo, entonces convertimos
# a tsibble un objeto que tiene orientación a este tiempo de
#procesamiento
Vacunastotales_tsibble <- Vacunastotales %>%
dplyr::mutate(Daily = as.Date(date)) %>%
dplyr::select(-date) %>%
tsibble::as_tsibble(key = location,
index = Daily)
#se hace una variable con los nombres de los paises de
#LATAM para asi poder llamar la variable a buscar en
#la base de datos si se requiere, esto esta pensado
#en que la instrucción podría hacerse varias veces
#entonces en teoría debería simplificar el código
latam <- c("Mexico", "Argentina",
"Colombia", "Chile",
"Brazil", "Bolivia",
"Costa Rica", "Ecuador",
"Guatemala", "Panama",
"Paraguay", "Peru",
"Puerto Rico", "Dominican Republic")
#Se encontro que era particularmente complicado mostrar
#todos los datos en una sola gráfica, por lo tanto,
#graficar por secciones y pegar con patchwork es una
#opción viable, por lo que la variable length(latam) = 14
#entonces dividimos en 2 grupos para tener símetria.
latam1 <- latam[1:7]
latam2 <- latam[8:14]
#latam == latam1 + latam2
#hacemos otro dafa frame que solo sea para los de
#LATAM y asi trabajamos con un tsibble más pequeña
Vacunas_latam_tsibble <- Vacunastotales_tsibble %>%
dplyr::select( Daily, location, total_vaccinations,
total_vaccinations_per_hundred,
daily_vaccinations_per_million) %>%
filter(location %in% latam)
```
Vacunación en LATAM
=========================================
Row
------------------------------------
### Escenario general
```{r}
#Gráfica que representa el escenario general para los paises
#de latam en el tiempo vacunados por cada 100
EscenarioLatam <- ggplot(data = Vacunas_latam_tsibble) +
geom_line(mapping = aes(x = Daily, y = total_vaccinations_per_hundred, color = location)) +
labs(x = 'meses',
y = 'Vacunas aplicadas por cada 100')
plotly::ggplotly(EscenarioLatam)
#Notas de el gráifco EscenarioLatam
#muestra una tendencia creciente
#con temporalidad variable
#No hay evidencia de comportmaiento ciclico
```
### Temporalidad (Mensual)
```{r}
# #Visualización por periocidad -------------------------------------------
#Utilizando la función gg_season para hacer graficas
#de la vacunación (2 gráficas por pais correspondiente a los
# 2 años de los que se tienen datos) por mes.
Vacunas_latam_tsibble %>%
filter(location %in% latam1) %>%
gg_season(total_vaccinations_per_hundred, labels = "both") +
labs(y = "Vacunas aplicadas por cada 100",
x = "Meses",
title = "Vacunación por meses en los diferentes paises de LATAM") +
expand_limits(x = ymd(c("2021-02","2021-04"))) -> g1
#se repite el codigo para hacer lo mismo y luego juntarlos
#con el apoyo de patch work
Vacunas_latam_tsibble %>%
filter(location %in% latam2) %>%
gg_season(total_vaccinations_per_hundred, labels = "both") +
labs(y = "Vacunas aplicadas por cada 100",
x = "Meses",
title = "Vacunación por meses en los diferentes paises de LATAM") +
expand_limits(x = ymd(c("2021-02","2021-04"))) -> g2
#No se estiliza que la asignación vaya hasta el final
#pues transgrede con el estilo del código, pero se recomienda
#en el libro de forescasting para darle "fluidez" a la lectura
#del código
#Se encuentra interesante que en marzo la mayoría de los paises
#tienen una linea constante
#Méxio y chile empezaron la vacunación en las últimas semanas
#de diciembre
# Visualización: Integración de los gráficos con PATCHWORK -----------------------------
#Establecemos un layout, que es basicamente un # para los espacios en blanco, y letras
#para los lugares que deseamos que ocupe la letra
layout <- '
AAAABBBB
AAAABBBB
AAAABBBB
'
#cambiamos el lugar de las letras en el layout por nuestrras gráficas
wrap_plots(A = g1,
B = g2,
design = layout)
```
### Temporalidad (semanal por mes)
```{r}
#Aquí vemos las gráficas anteriores más a detalle, pues podemos
#ver en que semanas de cada mes hay crecimiento
Vacunas_latam_tsibble %>%
filter(location %in% latam1) %>%
gg_season(total_vaccinations_per_hundred, period = "month") +
labs(y = "Vacunas aplicadas por cada 100",
x = "Periodicidad de las semanas del mes",
title = " Vacunación por semanana de los diferentes meses en los paises de LATAM") +
expand_limits(x = ymd(c("2021-02","2021-04"))) -> g3
#repetimos el código para la sección 2
Vacunas_latam_tsibble %>%
filter(location %in% latam2) %>%
gg_season(total_vaccinations_per_hundred, period = "month") +
labs(y = "Vacunas aplicadas por cada 100",
x = "Periodicidad de las semanas del mes",
title = " Vacunación por semanana de los diferentes meses en los paises de LATAM") +
expand_limits(x = ymd(c("2021-02","2021-04"))) -> g4
# Visualización: Integración de los gráficos con PATCHWORK -----------------------------
#Establecemos un layout, que es basicamente un # para los espacios en blanco, y letras
#para los lugares que deseamos que ocupe la letra
layout <- '
AAAABBBB
AAAABBBB
AAAABBBB
'
#cambiamos el lugar de las letras en el layout por nuestrras gráficas
wrap_plots(A = g3,
B = g4,
design = layout)
```
Row
------------------------------------
### Pronósticos
```{r}
# Definición del modelo ---------------------------------------------------
#TSLM(total_vaccinations_per_hundred ~ trend())
# Entrenamiento del modelo (Estimación) -----------------------------------
fit <- Vacunas_latam_tsibble %>%
model(Modelo_tendencia =
TSLM(total_vaccinations_per_hundred ~ trend()))
#fit
# Revisar el desempeño del modelo (evaluación) ----------------------------
# Producir pronósticos ----------------------------------------------------
#Se genera la tabla de pronósticos, el cual va ser
#una tabla de tipo fable (objeto) es decir
#forecasting table
fcst <- fit %>% forecast(h = 3) #se hace para los siguientes 3 meses
#pues los datos que se tienen hasta el momento
# son de 4 - 5 meses
#fcst
# Visualización de la forecasting table
#para grupo 1 latama
fcst %>%
filter(location %in% latam1) %>%
autoplot(Vacunas_latam_tsibble) +
ggtitle('Vacunas en LATAM') +
ylab('Vacunas aplicadas por cada 100') +
xlab('Mes') -> fcst1
#para grupo 2 latam
fcst %>%
filter(location %in% latam2) %>%
autoplot(Vacunas_latam_tsibble) +
ggtitle('Vacunas en LATAM') +
ylab('Vacunas aplicadas por cada 100') +
xlab('Mes') -> fcst2
#integración de las visualizaciones
fcst3 = fcst1 + fcst2
fcst3
```